home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
h
/
frame.h
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
3KB
|
124 lines
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
/*
frame.h
frame stack and non-local jump
*/
/* IHS Invocation History Stack */
typedef struct invocation_history {
object ihs_function;
object *ihs_base;
} *ihs_ptr;
#define IHSSIZE 1024
#define IHSGETA 32
struct invocation_history ihs_stack[IHSSIZE + IHSGETA + IHSGETA];
#define ihs_org ihs_stack
ihs_ptr ihs_limit;
ihs_ptr ihs_top;
#define ihs_check \
if (ihs_top >= ihs_limit) \
ihs_overflow()
#define ihs_push(function) \
(++ihs_top)->ihs_function = (function); \
ihs_top->ihs_base = vs_base
#define ihs_pop() (ihs_top--)
#define make_nil_block() \
{ \
object x; \
\
lex_copy(); \
x = alloc_frame_id(); \
vs_push(x); \
lex_block_bind(Cnil, x); \
vs_pop; \
frs_push(FRS_CATCH, x); \
}
/* Frame Stack */
enum fr_class {
FRS_CATCH, /* for catch,block,tabbody */
FRS_CATCHALL, /* for catchall */
FRS_PROTECT /* for protect-all */
};
struct frame {
jmp_buf frs_jmpbuf;
object *frs_lex;
bds_ptr frs_bds_top;
enum fr_class frs_class;
object frs_val;
ihs_ptr frs_ihs;
};
typedef struct frame *frame_ptr;
#define alloc_frame_id() alloc_object(t_spice)
/*
frs_class | frs_value | frs_prev
----------+--------------------------------------+--------------
CATCH | frame-id, i.e. |
| throw-tag, |
| block-id (uninterned symbol), or | value of ihs_top
| tagbody-id (uninterned symbol) | when the frame
----------+--------------------------------------| was pushed
CATCHALL | NIL |
----------+--------------------------------------|
PROTECT | NIL |
----------------------------------------------------------------
*/
#define FRSSIZE 1024
#define FRSGETA 16
struct frame frame_stack[FRSSIZE + FRSGETA + FRSGETA];
#define frs_org frame_stack
frame_ptr frs_limit;
frame_ptr frs_top; /* frame stack top */
#define frs_push(class, val) \
if (++frs_top >= frs_limit) \
frs_overflow(); \
frs_top->frs_lex = lex_env;\
frs_top->frs_bds_top = bds_top; \
frs_top->frs_class = (class); \
frs_top->frs_val = (val); \
frs_top->frs_ihs = ihs_top; \
setjmp(frs_top->frs_jmpbuf)
#define frs_pop() frs_top--
/* global variables used during non-local jump */
bool nlj_active; /* true during non-local jump */
frame_ptr nlj_fr; /* frame to return */
object nlj_tag; /* throw-tag, block-id, or */
/* (tagbody-id . label). */